perm filename TOUCH.LSP[E87,JMC] blob sn#843019 filedate 1987-07-17 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	touch.lsp[e87,jmc]	Program tested on Butterfly
C00004 ENDMK
CāŠ—;
;;;touch.lsp[e87,jmc]	Program tested on Butterfly

;(defun touch (x)
;      (if (atom x)
;	   x
;	   (if (greaterp (rank x) k)
;	       (foo (future (touch (cadr x)))
;		    (future (touch (caddr x))))
;	       (touch1 x))))

(defun touch (x)
       (if (atom x)
	   x
	   (if (greaterp (rank x) k)
	       (qlet t ((a (touch (cadr x)))
			(b (touch (caddr x))))
		     (foo a b))
	       (touch1 x))))

; remove this definition for system with future
(defun future (x) x)

(defun rank (x) (car x))

(defun touch1 (x) 
       (if (atom x)
	   x
	   (foo (touch1 (cadr x)) (touch1 (caddr x)))))

(defun mktest (n)
       (if (= n 0)
	   'a
	   (list n (mktest (1- n)) (mktest (1- n)))))

(setq k 2)

(setq z (mktest 3))

(defun foo (x y) t)

(touch z)